home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / misc / math / highprecision.lha / CenturyCalc.e next >
Encoding:
Text File  |  1998-07-31  |  12.9 KB  |  478 lines
  1. /* E Source generated by SRCGEN v0.1 */
  2.  
  3. OPT OSVERSION=37
  4.  
  5. MODULE 'gadtools','libraries/gadtools','intuition/intuition',
  6.        'intuition/screens', 'intuition/gadgetclass', 'graphics/text',
  7.        'highprecision'
  8.  
  9. ENUM NONE,NOCONTEXT,NOGADGET,NOWB,NOVISUAL,OPENGT,NOWINDOW,NOMENUS
  10.  
  11. DEF  big_calcwnd:PTR TO window,
  12.    big_calcmenus,
  13.    big_calcglist,
  14.    infos:PTR TO gadget,
  15.    scr:PTR TO screen,
  16.    visual=NIL,
  17.    offx,offy,tattr,hps
  18. DEF q,r:PTR TO gadget,p1,hpx,hpy,hpm,x,y,op,power,p,pp,abt,l2,ef
  19.  
  20. PROC setupscreen()
  21.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN OPENGT
  22.   IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN NOWB
  23.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN NOVISUAL
  24.   offy:=scr.wbortop+Int(scr.rastport+58)-10
  25.   tattr:=['topaz.font',8,0,0]:textattr
  26. ENDPROC
  27.  
  28. PROC closedownscreen()
  29.   IF visual THEN FreeVisualInfo(visual)
  30.   IF scr THEN UnlockPubScreen(NIL,scr)
  31.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  32. ENDPROC
  33.  
  34. PROC openbig_calcwindow()
  35.   DEF g:PTR TO gadget
  36.   IF (g:=CreateContext({big_calcglist}))=NIL THEN RETURN NOCONTEXT
  37.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  38.     [offx+31,offy+55,31,16,'CA',tattr,0,16,visual,1]:newgadget,
  39.     [NIL]))=NIL THEN RETURN NOGADGET
  40.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  41.     [offx+62,offy+55,31,16,'CE',tattr,1,16,visual,2]:newgadget,
  42.     [NIL]))=NIL THEN RETURN NOGADGET
  43.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  44.     [offx+93,offy+55,31,16,'e',tattr,2,16,visual,3]:newgadget,
  45.     [NIL]))=NIL THEN RETURN NOGADGET
  46.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  47.     [offx+31,offy+119,62,16,'0',tattr,3,16,visual,4]:newgadget,
  48.     [NIL]))=NIL THEN RETURN NOGADGET
  49.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  50.     [offx+31,offy+103,31,16,'1',tattr,4,16,visual,5]:newgadget,
  51.     [NIL]))=NIL THEN RETURN NOGADGET
  52.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  53.     [offx+62,offy+103,31,16,'2',tattr,5,16,visual,6]:newgadget,
  54.     [NIL]))=NIL THEN RETURN NOGADGET
  55.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  56.     [offx+93,offy+103,31,16,'3',tattr,6,16,visual,7]:newgadget,
  57.     [NIL]))=NIL THEN RETURN NOGADGET
  58.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  59.     [offx+31,offy+87,31,16,'4',tattr,7,16,visual,8]:newgadget,
  60.     [NIL]))=NIL THEN RETURN NOGADGET
  61.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  62.     [offx+62,offy+87,31,16,'5',tattr,8,16,visual,9]:newgadget,
  63.     [NIL]))=NIL THEN RETURN NOGADGET
  64.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  65.     [offx+93,offy+87,31,16,'6',tattr,9,16,visual,10]:newgadget,
  66.     [NIL]))=NIL THEN RETURN NOGADGET
  67.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  68.     [offx+31,offy+71,31,16,'7',tattr,10,16,visual,11]:newgadget,
  69.     [NIL]))=NIL THEN RETURN NOGADGET
  70.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  71.     [offx+62,offy+71,31,16,'8',tattr,11,16,visual,12]:newgadget,
  72.     [NIL]))=NIL THEN RETURN NOGADGET
  73.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  74.     [offx+93,offy+71,31,16,'9',tattr,12,16,visual,13]:newgadget,
  75.     [NIL]))=NIL THEN RETURN NOGADGET
  76.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  77.     [offx+93,offy+119,31,16,'.',tattr,13,16,visual,14]:newgadget,
  78.     [NIL]))=NIL THEN RETURN NOGADGET
  79.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  80.     [offx+124,offy+55,31,16,'/',tattr,14,16,visual,15]:newgadget,
  81.     [NIL]))=NIL THEN RETURN NOGADGET
  82.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  83.     [offx+124,offy+71,31,16,'*',tattr,15,16,visual,16]:newgadget,
  84.     [NIL]))=NIL THEN RETURN NOGADGET
  85.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  86.     [offx+124,offy+87,31,16,'-',tattr,16,16,visual,17]:newgadget,
  87.     [NIL]))=NIL THEN RETURN NOGADGET
  88.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  89.     [offx+124,offy+103,31,16,'+',tattr,17,16,visual,18]:newgadget,
  90.     [NIL]))=NIL THEN RETURN NOGADGET
  91.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  92.     [offx+124,offy+119,31,16,'=',tattr,18,16,visual,19]:newgadget,
  93.     [NIL]))=NIL THEN RETURN NOGADGET
  94.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  95.     [offx+155,offy+55,31,16,'/2',tattr,19,16,visual,20]:newgadget,
  96.     [NIL]))=NIL THEN RETURN NOGADGET
  97.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  98.     [offx+155,offy+71,31,16,'*2',tattr,20,16,visual,21]:newgadget,
  99.     [NIL]))=NIL THEN RETURN NOGADGET
  100.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  101.     [offx+0,offy+55,31,16,'PWR',tattr,21,16,visual,22]:newgadget,
  102.     [NIL]))=NIL THEN RETURN NOGADGET
  103.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  104.     [offx+0,offy+71,31,16,'SQR',tattr,22,16,visual,23]:newgadget,
  105.     [NIL]))=NIL THEN RETURN NOGADGET
  106.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  107.     [offx+0,offy+87,31,16,'INT',tattr,23,16,visual,24]:newgadget,
  108.     [NIL]))=NIL THEN RETURN NOGADGET
  109.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  110.     [offx+0,offy+103,31,16,'FRC',tattr,24,16,visual,25]:newgadget,
  111.     [NIL]))=NIL THEN RETURN NOGADGET
  112.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  113.     [offx+0,offy+119,31,16,'ABS',tattr,25,16,visual,26]:newgadget,
  114.     [NIL]))=NIL THEN RETURN NOGADGET
  115.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  116.     [offx+155,offy+87,31,16,'MS',tattr,26,16,visual,27]:newgadget,
  117.     [NIL]))=NIL THEN RETURN NOGADGET
  118.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  119.     [offx+155,offy+103,31,16,'MR',tattr,27,16,visual,28]:newgadget,
  120.     [NIL]))=NIL THEN RETURN NOGADGET
  121.   IF (g:=CreateGadgetA(BUTTON_KIND,g,
  122.     [offx+155,offy+119,31,16,'1/X',tattr,28,16,visual,29]:newgadget,
  123.     [NIL]))=NIL THEN RETURN NOGADGET
  124.   IF (big_calcmenus:=CreateMenusA([1,0,'Project',0,$0,0,0,
  125.     2,0,'Save','S',$0,0,30,
  126.     2,0,'About','A',$0,0,31,
  127.     2,0,'Format',0,$0,0,32,
  128.     3,0,'Zeros','Z',$9,0,33,
  129.     3,0,'Exponent','E',$9,0,34,
  130.     3,0,'sCi','C',$9,0,35,
  131.     2,0,'Quit','Q',$0,0,36,
  132.     0,0,0,0,0,0,0]:newmenu,NIL))=NIL THEN RETURN NOMENUS
  133.   IF LayoutMenusA(big_calcmenus,visual,NIL)=FALSE THEN RETURN NOMENUS
  134.   IF (big_calcwnd:=OpenWindowTagList(NIL,
  135.     [WA_LEFT,218,
  136.      WA_TOP,24,
  137.      WA_WIDTH,offx+194,
  138.      WA_HEIGHT,offy+148,
  139.      WA_IDCMP,$26C077E,->vanillakey $200000
  140.      WA_FLAGS,$142E,
  141.      WA_TITLE,'Century Calc',
  142.      WA_CUSTOMSCREEN,scr,
  143.      WA_MINWIDTH,67,
  144.      WA_MINHEIGHT,21,
  145.      WA_MAXWIDTH,$280,
  146.      WA_MAXHEIGHT,200,
  147.      WA_AUTOADJUST,1,
  148.      WA_AUTOADJUST,1,
  149.      WA_GADGETS,big_calcglist,
  150.      NIL]))=NIL THEN RETURN NOWINDOW
  151.      stdrast:=big_calcwnd.rport
  152.   PrintIText(big_calcwnd.rport,
  153.     [1,0,0,9,4,tattr,'-1.234567890123456789',NIL]:intuitext,offx,offy)
  154.   PrintIText(big_calcwnd.rport,
  155.     [1,0,0,9,12,tattr,'012345678901234567890',NIL]:intuitext,offx,offy)
  156.   PrintIText(big_calcwnd.rport,
  157.     [1,0,0,9,20,tattr,'123456789012345678901',NIL]:intuitext,offx,offy)
  158.   PrintIText(big_calcwnd.rport,
  159.     [1,0,0,9,28,tattr,'234567890123456789012',NIL]:intuitext,offx,offy)
  160.   PrintIText(big_calcwnd.rport,
  161.     [1,0,0,9,36,tattr,'345678901234567890',NIL]:intuitext,offx,offy)
  162.   PrintIText(big_calcwnd.rport,
  163.     [1,0,0,9,44,tattr,'e-123456789',NIL]:intuitext,offx,offy)
  164.   DrawBevelBoxA(big_calcwnd.rport,0+offx,0+offy,186,55,
  165.     [GT_VISUALINFO,visual,NIL])
  166.   IF SetMenuStrip(big_calcwnd,big_calcmenus)=FALSE THEN RETURN NOMENUS
  167.   Gt_RefreshWindow(big_calcwnd,NIL)
  168. ENDPROC
  169.  
  170. PROC closebig_calcwindow()
  171.   IF big_calcwnd THEN ClearMenuStrip(big_calcwnd)
  172.   IF big_calcmenus THEN FreeMenus(big_calcmenus)
  173.   IF big_calcwnd THEN CloseWindow(big_calcwnd)
  174.   IF big_calcglist THEN FreeGadgets(big_calcglist)
  175. ENDPROC
  176.  
  177. PROC wait4message(win:PTR TO window)
  178.   DEF mes:PTR TO intuimessage,type,item
  179.   REPEAT
  180.     type:=0
  181.     IF mes:=Gt_GetIMsg(win.userport)
  182.       type:=mes.class
  183.       IF type=IDCMP_MENUPICK
  184.         infos:=mes.code
  185.       ELSEIF (type=IDCMP_GADGETDOWN) OR (type=IDCMP_GADGETUP)
  186.         infos:=mes.iaddress
  187.       ELSEIF type=IDCMP_REFRESHWINDOW
  188.         Gt_BeginRefresh(win)
  189.         Gt_EndRefresh(win,TRUE)
  190.         type:=0
  191.       ELSEIF type=IDCMP_VANILLAKEY
  192.          infos:=mes.code
  193.       ELSEIF type<>IDCMP_CLOSEWINDOW  /* remove these if you like */
  194.         type:=0
  195.       ENDIF
  196.       Gt_ReplyIMsg(mes)
  197.     ELSE
  198.       WaitPort(win.userport)
  199.     ENDIF
  200.   UNTIL type
  201. ENDPROC type
  202.  
  203. PROC reporterr(er)
  204.   DEF erlist:PTR TO LONG
  205.   IF er
  206.     erlist:=['get context','create gadget','lock wb','get visual infos',
  207.       'open "gadtools.library" v37+','open window','create menus']
  208.     EasyRequestArgs(0,[20,0,0,'Could not \s!','ok'],0,[erlist[er-1]])
  209.   ENDIF
  210. ENDPROC er
  211.  
  212. PROC main()
  213.  
  214. IF (highprecisionbase:=OpenLibrary('highprecision.library',1))<>0
  215. IF HpSetup(100)<>0
  216. hpx:=HpMakeVar()
  217. hpy:=HpMakeVar()
  218. hpm:=HpMakeVar()
  219. hps:=HpMakeStr()
  220. pp:=0
  221. p:=0
  222. ef:=1
  223.   IF reporterr(setupscreen())=0
  224.     reporterr(openbig_calcwindow())
  225.     WHILE (q:= wait4message(big_calcwnd))<>$200
  226.     IF q=$40
  227.     r:=infos
  228.     p1:=r.userdata
  229.     ELSEIF q=$100
  230.      p1:=Long(ItemAddress(big_calcmenus,infos AND $FFFF)+34)
  231.     ELSEIF q=IDCMP_VANILLAKEY
  232.      IF infos=$65
  233.       p1:=3
  234.      ELSEIF infos=$2e
  235.       p1:=14
  236.      ELSEIF infos=$2f
  237.       p1:=15
  238.      ELSEIF infos=$2a
  239.       p1:=16
  240.      ELSEIF infos=$2d
  241.       p1:=17
  242.      ELSEIF infos=$2b
  243.       p1:=18
  244.      ELSEIF (infos=$3d) OR (infos=$d)
  245.       p1:=19
  246.      ELSEIF (infos>="0") AND (infos<="9")
  247.       p1:=infos-$2c
  248.      ENDIF
  249.     ENDIF
  250.     IF p1=36 THEN BRA yy
  251.      SELECT p1
  252.       CASE 1
  253.        Box(2,1,182,53,0)
  254.        HpClear(hpx)
  255.        HpClear(hpy)
  256.        HpClear(hpm)
  257.        pp:=0
  258.        hps[pp]:=0
  259.        ef:=1
  260.       CASE 2
  261.        IF pp=0
  262.        HpClear(y)
  263.        Box(2,1,182,53,0)
  264.        ELSE
  265.        pp:=pp-1
  266.        TextF(Mod(pp,21)*8+9,pp/21*8+10,'\c'," ")
  267.        hps[pp]:=0
  268.        ENDIF
  269.       CASE 15
  270.        cases(15)
  271.       CASE 16
  272.        cases(16)
  273.       CASE 17
  274.        IF ((pp=0) AND (ef=0)) OR (hps[pp-1]="e")
  275.         IF pp=0 THEN Box(2,1,182,53,0)
  276.         Colour(1,0)
  277.         TextF(Mod(pp,21)*8+9,pp/21*8+10,'\c',"-")
  278.         hps[pp++]:="-"
  279.        ELSE
  280.         cases(17)
  281.        ENDIF
  282.       CASE 18
  283.        cases(18)
  284.       CASE 19
  285.        ef:=1
  286.        doit()
  287.       CASE 20
  288.        IF pp<>0
  289.         hps[pp]:=0
  290.         pp:=0
  291.         Str2hp(hps,hpy)
  292.        ENDIF
  293.        HpHalf(hpy,hpy)
  294.        Hp2str(hpy,hps,p)
  295.        showstring()
  296.       CASE 21
  297.        IF pp<>0
  298.         hps[pp]:=0
  299.         pp:=0
  300.         Str2hp(hps,hpy)
  301.        ENDIF
  302.        HpDouble(hpy,hpy)
  303.        Hp2str(hpy,hps,p)
  304.        showstring()
  305.       CASE 22
  306.        cases(22)
  307.       CASE 23
  308.        IF pp<>0
  309.         hps[pp]:=0
  310.         pp:=0
  311.         Str2hp(hps,hpy)
  312.        ENDIF
  313.        HpSqrt(hpy,hpy)
  314.        Hp2str(hpy,hps,p)
  315.        showstring()
  316.       CASE 24
  317.        IF pp<>0
  318.         hps[pp]:=0
  319.         pp:=0
  320.         Str2hp(hps,hpy)
  321.        ENDIF
  322.        HpInt(hpy,hpy)
  323.        Hp2str(hpy,hps,p)
  324.        showstring()
  325.       CASE 25
  326.        IF pp<>0
  327.         hps[pp]:=0
  328.         pp:=0
  329.         Str2hp(hps,hpy)
  330.        ENDIF
  331.        HpFrc(hpy,hpy)
  332.        Hp2str(hpy,hps,p)
  333.        showstring()
  334.       CASE 26
  335.        IF pp<>0
  336.         hps[pp]:=0
  337.         pp:=0
  338.         Str2hp(hps,hpy)
  339.        ENDIF
  340.        HpAbs(hpy,hpy)
  341.        Hp2str(hpy,hps,p)
  342.        showstring()
  343.       CASE 27
  344.        IF pp<>0
  345.         hps[pp]:=0
  346.         Str2hp(hps,hpm)
  347.        ELSE
  348.         HpCopy(hpy,hpm)
  349.        ENDIF
  350.       CASE 28
  351.        pp:=0
  352.        HpCopy(hpm,hpy)
  353.        Hp2str(hpy,hps,p)
  354.        ->WriteF('recalled \s\n',hps)
  355.        showstring()
  356.       CASE 29
  357.        IF pp<>0
  358.         hps[pp]:=0
  359.         pp:=0
  360.         Str2hp(hps,hpy)
  361.        ENDIF
  362.        HpRec(hpy,hpy)
  363.        Hp2str(hpy,hps,p)
  364.        showstring()
  365.       CASE 30
  366.        abt:=Open('T:Number',NEWFILE)
  367.        l2:=0
  368.        WHILE hps[l2]<>0 DO l2++
  369.        Write(abt,hps,l2)
  370.        Close(abt)
  371.       CASE 31
  372.        abt:='Written using the\nHighPrecision Library\nCreated by\nRalf P. Quimby'
  373.        EasyRequestArgs(big_calcwnd,[20,0,0,abt,'Okay'],0,NIL)
  374.       CASE 32
  375.        NOP
  376.       CASE 33
  377.        p:=Eor(p,4)
  378.       CASE 34
  379.        p:=Eor(p,2)
  380.       CASE 35
  381.        p:=Eor(p,1)
  382.       DEFAULT
  383.        IF (p1>2) AND (p1<15)
  384.        IF pp=0
  385.         ->HpClear(hpy)
  386.         Box(2,1,182,53,0)
  387.        ENDIF
  388.         Colour(1,0)
  389.         IF p1=3
  390.         TextF(Mod(pp,21)*8+9,pp/21*8+10,'\c',"e")
  391.         hps[pp]:="e"
  392.         ELSEIF p1=14
  393.         TextF(Mod(pp,21)*8+9,pp/21*8+10,'\c',".")
  394.         hps[pp]:="."
  395.         ELSE
  396.         TextF(Mod(pp,21)*8+9,pp/21*8+10,'\d',p1-4)
  397.         hps[pp]:=p1-4+"0"
  398.         ENDIF
  399.         IF pp<115 THEN pp:=pp+1
  400.        ENDIF
  401.     ENDSELECT
  402.     ENDWHILE
  403. yy:  closebig_calcwindow()
  404.     IF CtrlC() THEN BRA xx
  405.   ENDIF
  406.   xx: closedownscreen()
  407.   CloseLibrary(highprecisionbase)
  408. ELSE
  409.  EasyRequestArgs(big_calcwnd,[20,0,0,'No\nRoom','Okay'],0,NIL)
  410. ENDIF
  411. ELSE
  412.  EasyRequestArgs(big_calcwnd,[20,0,0,'No\nLib','Okay'],0,NIL)
  413. ENDIF
  414. ENDPROC
  415.  
  416. PROC showstring()
  417. DEF l,l2,s[22]:ARRAY OF CHAR,y
  418. ->WriteF('showing \s\n',hps)
  419. y:=0
  420. l:=0
  421. l2:=0
  422. Box(2,1,182,53,0)
  423. Colour(1,0)
  424. WHILE hps[l]<>0
  425.  s[l2]:=hps[l]
  426.  l++
  427.  l2++
  428.  IF (l2=21) OR (hps[l]="e") OR (hps[l]=0)
  429.   s[l2]:=0
  430.   TextF(9,y*8+10,'\s',s)
  431.   l2:=0
  432.   y++
  433.  ENDIF
  434. ENDWHILE
  435. ENDPROC
  436.  
  437. PROC cases(q)
  438.  
  439. IF ef=0 THEN doit()
  440.  
  441. op:=q
  442.        IF pp>0
  443.         hps[pp]:=0
  444.         pp:=0
  445.         Str2hp(hps,hpx)
  446.        ELSE
  447.         HpCopy(hpy,hpx)
  448.        ENDIF
  449.        ef:=0
  450.        ->WriteF('x= \s\n',hps)
  451. ENDPROC
  452.  
  453. PROC doit()
  454.        IF pp>0
  455.         hps[pp]:=0
  456.         pp:=0
  457.         Str2hp(hps,hpy)
  458.        ENDIF
  459.        IF op=15
  460.          HpDiv(hpx,hpy,hpy)
  461.        ELSEIF op=16
  462.         HpMul(hpx,hpy,hpy)
  463.        ELSEIF op=17
  464.         HpSub(hpx,hpy,hpy)
  465.        ELSEIF op=18
  466.         HpAdd(hpx,hpy,hpy)
  467.        ELSEIF op=22
  468.         power:=Hp2int(hpy)
  469.         HpPower(hpx,power,hpy)
  470.        ENDIF
  471.        Hp2str(hpy,hps,p)
  472.        showstring()
  473. ENDPROC
  474. /*EE folds
  475. -1
  476. 20 5 23 3 26 133 29 4 32 23 35 6 242 18 245 13 248 19 
  477. EE folds*/
  478.